home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / qbnws302.zip / HASH.ZIP / HASH.BAS
BASIC Source File  |  1992-06-20  |  16KB  |  518 lines
  1. ' Hashed Access Demonstration Program For The QuickBasic Echo
  2. ' By Mike Avery, Started 12-28-91
  3. ' Version 1:00.00 - Make it work. 12-28-91
  4. ' Version 1:01.00 - Add Disk Functions 12-29-91
  5. ' ========================================================================
  6.  
  7. DECLARE FUNCTION Hash! (TestString$)
  8. DECLARE SUB GetData (Key$, Index%, SeekCount%, SaveIndex%)
  9. DECLARE SUB Waiter ()
  10. DECLARE FUNCTION WhackIt$ (InputString$)
  11.  
  12. CONST DeletedValue$ = "EXPLETIVE DELETED"
  13. CONST ArraySize% = 531         'Change the size here - the rest adjusts itself
  14. CONST RetryLimit% = 100        'I get bored easily....
  15. CONST ScreenLimit% = 21        'how many lines do we show at once?
  16. CONST True = -1: CONST False = NOT (True)
  17.  
  18. DIM SHARED A$(ArraySize%, 1)          'our little data base
  19. DIM SHARED SortSpace$(ArraySize%, 1)  'Workspace for sorted lists
  20.  
  21. PowerMax% = INT((LOG(ArraySize%) / LOG(2)) + 2)
  22. DIM SHARED PowersOfTwo%(PowerMax%)
  23.  
  24. 'build the table - lookup is faster than calculation
  25. FOR I% = 0 TO PowerMax%
  26.     PowersOfTwo%(I%) = 2 ^ I%
  27. NEXT I%
  28.  
  29. DO WHILE TestName$ <> "STOP"
  30.    CLS
  31.    PRINT "Doofus Phone Book System"
  32.    PRINT
  33.    PRINT
  34.    INPUT "Name/Help/Dump/Sort/Load/Save/Analyse/Stop"; TestName$
  35.    TestName$ = UCASE$(RTRIM$(LTRIM$(TestName$)))
  36.   
  37.    IF TestName$ = "DUMP" THEN
  38.       GOSUB DumpIt
  39.  
  40.    ELSEIF TestName$ = "SORT" THEN
  41.       GOSUB SortIt
  42.  
  43.    ELSEIF TestName$ = "ANALYSE" THEN
  44.       GOSUB Analyse
  45.  
  46.    ELSEIF TestName$ = "HELP" THEN
  47.       GOSUB Help
  48.  
  49.    ELSEIF TestName$ = "LOAD" THEN
  50.       GOSUB LoadIt
  51.  
  52.    ELSEIF TestName$ = "SAVE" THEN
  53.       GOSUB SaveIt
  54.   
  55.    ELSEIF TestName$ <> "" AND TestName$ <> "STOP" THEN
  56.       CALL GetData(TestName$, Index%, SeekCount%, SaveIndex%)
  57.  
  58.       ' At this point, one of 3 conditions exists.
  59.       ' 1. We ran out of retries, and it doesn't matter what Index% points to,
  60.       ' 2. Index% points to our data, or
  61.       ' 3. Index% points to an empty record and SaveIndex may or may not
  62.       '    point to a deleted record we can reuse.
  63.      
  64.       PRINT
  65.       PRINT "It took "; SeekCount%; "tries to determine that..."
  66.       'in a productional program, you'd probably drop that message...
  67.  
  68.       PRINT
  69.  
  70.       IF SeekCount% >= RetryLimit% THEN
  71.          PRINT "The data base is full and/or needs to be resized"
  72.          YesOrNo$ = ""
  73.          DO WHILE YesOrNo$ <> "Y" AND YesOrNo$ <> "N"
  74.             INPUT "Do you want to see a data base dump (Y/N)"; YesOrNo$
  75.             IF YesOrNo$ <> "" THEN
  76.                YesOrNo$ = WhackIt$(YesOrNo$)
  77.             END IF
  78.             IF YesOrNo$ = "Y" THEN
  79.                GOSUB DumpIt
  80.             ELSEIF YesOrNo$ <> "N" THEN
  81.                PRINT "Please Enter A Y for Yes or a N for NO."
  82.             END IF
  83.          LOOP
  84.  
  85.          TestName$ = "STOP"'force a shutdown
  86.          CALL Waiter
  87.          ' save data base here, if converted to a disk based system
  88.  
  89.       ELSEIF A$(Index%, 0) = TestName$ THEN
  90.          PRINT A$(Index%, 0); "'s Phone Number Is "; A$(Index%, 1); "."
  91.          Action$ = "Dummy"
  92.          DO WHILE Action$ <> "" AND Action$ <> "C" AND Action$ <> "D"
  93.             INPUT "Change the number, Delete The Number, or enter"; Action$
  94.             
  95.             IF Action$ <> "" THEN
  96.                Action$ = WhackIt$(Action$)
  97.               
  98.                IF Action$ = "C" THEN
  99.                   'else if we are to change the number
  100.                   INPUT "New phone number please"; PhoneNumber$
  101.                   PhoneNumber$ = UCASE$(RTRIM$(LTRIM$(PhoneNumber$)))
  102.  
  103.                   IF PhoneNumber$ = "" THEN
  104.                      PRINT "Number not changed"
  105.                   ELSE
  106.                      A$(Index%, 1) = PhoneNumber$
  107.                      PRINT "Phone number has been updated."
  108.                   END IF
  109.  
  110.                ELSEIF Action$ = "D" THEN
  111.                   A$(Index%, 0) = DeletedValue$
  112.                   PRINT "Entry has been deleted."
  113.  
  114.                ELSE
  115.                   'an invalid entry was made
  116.                   PRINT "Please enter a D to Delete the number,"
  117.                   PRINT "a C to Change it, or"
  118.                   PRINT "just press Enter to continue."
  119.                   Action$ = "DUMMY"
  120.                END IF
  121.             END IF
  122.          LOOP
  123.  
  124.       ELSE
  125.          PRINT TestName$; "'s Phone Number Is Not On File.  You May Enter It To Add"
  126.          PRINT "It, Or Just Press "; CHR$(34); "ENTER"; CHR$(34); " To Continue.";
  127.          INPUT PhoneNumber$
  128.          PhoneNumber$ = UCASE$(RTRIM$(LTRIM$(PhoneNumber$)))
  129.  
  130.          IF PhoneNumber$ <> "" THEN
  131.             IF SaveIndex% <> -1 THEN
  132.                'reuse delete space
  133.                Index% = SaveIndex%
  134.                PRINT "We are reclaiming unused space!  Ain't it great!"
  135.                CALL Waiter
  136.             END IF
  137.  
  138.             A$(Index%, 0) = TestName$
  139.             A$(Index%, 1) = PhoneNumber$
  140.          END IF
  141.       END IF
  142.  
  143.    END IF
  144. LOOP
  145.  
  146. ExitRoutine:
  147. SYSTEM
  148.  
  149. Analyse:
  150. 'process all the data elements in A$ to see:
  151. ' how full A$ is,
  152. ' best and worst case access to A$,
  153. ' mean, SD of access count
  154.  
  155. ' Statistics routines "borrowed" in part from
  156. ' "Some Common Basic Programs" pg 121-122
  157. ' by Lon Poole and Mary Borchers
  158. ' Published by Adam Osborne
  159. ' Copyright 1977
  160. ' pages 121-123
  161. PRINT "Analysis Begins.... Please Wait....."
  162.  
  163. Best% = 999
  164. Worst% = 0
  165. S = 0 ' we are dealing with a population, not a sample
  166. N = 0 ' count of active elements
  167. M = 0 ' Sum of X^2
  168. P = 0 ' Sum of X
  169.  
  170. FOR I% = 0 TO ArraySize%
  171.     IF A$(I%, 0) <> "" AND A$(I%, 0) <> DeletedValue$ THEN
  172.        CALL GetData(A$(I%, 0), Index%, Tries%, FirstDeleted%)
  173.        N = N + 1              ' Bump entry count
  174.        P = P + Tries%         ' Bump sum of X
  175.        M = M + (Tries% ^ 2)   ' Bump sum of X^2
  176.  
  177.        IF Tries% < Best% THEN
  178.           Best% = Tries%
  179.           BestOne% = Index%
  180.        END IF
  181.  
  182.        IF Tries% > Worst% THEN
  183.           Worst% = Tries%
  184.           WorstOne% = Index%
  185.        END IF
  186.     END IF
  187. NEXT I%
  188.  
  189. IF N > 0 THEN
  190.    PRINT "Access Analysis....."
  191.    R = P / N
  192.    PRINT "Number Of Entries ="; N
  193.    PRINT "Percent Full ="; INT((N / (ArraySize% + 1)) * 100); "%"
  194.    PRINT "Average Access ="; R; "Seeks."
  195.    V = (M - N * R ^ 2) / (N - S)
  196.    SD = SQR(V)
  197.    PRINT "Standard Deviation ="; SD
  198.    PRINT "Best Access ="; Best%; "Seeks On "; A$(BestOne%, 0); "."
  199.    PRINT "Worst Access ="; Worst%; "Seeks On "; A$(WorstOne%, 0); "."
  200. ELSE
  201.    PRINT "No Data To Analyze.  Sorry."
  202. END IF
  203.  
  204. CALL Waiter
  205. RETURN
  206.  
  207. DumpIt:
  208. DisplayControl% = 0
  209. FOR I% = 0 TO ArraySize%
  210.     PRINT I%, A$(I%, 0), A$(I%, 1)
  211.     DisplayControl% = DisplayControl% + 1
  212.     IF DisplayControl% > ScreenLimit% THEN
  213.        CALL Waiter
  214.        DisplayControl% = 0
  215.     END IF
  216. NEXT I%
  217.  
  218. CALL Waiter
  219. RETURN
  220.  
  221. ErrorHandler:
  222.  
  223. PRINT "ErrorHandler Sez...."
  224.  
  225. IF ERR = 53 OR ERR = 76 OR ERR = 68 OR ERR = 52 OR ERR = 64 OR ERR = 75 THEN
  226.    PRINT "A file you wanted to process, "; FileName$
  227.    PRINT "Could not be found/created."
  228.    Found = False
  229.    CALL Waiter
  230.    RESUME NEXT
  231. END IF
  232.  
  233. IF ERR = 61 THEN
  234.    PRINT "Sorry, the disk is full."
  235. ELSE
  236.    PRINT "You had an Error #"; ERR
  237. END IF
  238.  
  239. PRINT "Press any key to quit...."
  240. K$ = ""
  241. DO WHILE K$ = ""
  242.    K$ = INKEY$
  243. LOOP
  244. RESUME ExitRoutine
  245.  
  246. Help:
  247. 'Display a primitive help screen
  248. CLS
  249. PRINT "Doofus Phone Book System"
  250. PRINT
  251. PRINT
  252. PRINT "Name/Help/Dump/Sort/Load/Save/Analyse/Stop? HELP"
  253. PRINT
  254. PRINT "The Doofus Phone Book System was written as a demonstration of Hashed"
  255. PRINT "Data Access, rather than as a phone book system.  If it works for you,"
  256. PRINT "fine, but that was not the author's intent."
  257. PRINT
  258. PRINT "At the first prompt "; CHR$(34); "Name/Help/Dump/Sort/Load/Save/Analyse:"; CHR$(34); ","
  259. PRINT "You may enter a name to be added or looked up in the data base by entering"
  260. PRINT "the name."
  261. PRINT "You may ask for help by entering "; CHR$(34); "HELP"; CHR$(34); "."
  262. PRINT "You may see a raw dump of the data array by entering "; CHR$(34); "DUMP"; CHR$(34); "."
  263. PRINT "You may see a sorted data dump of the array by entering "; CHR$(34); "SORT"; CHR$(34); "."
  264. PRINT "